home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Internet_S2129451042008.psc / Internet Scouting / Glob.bas next >
BASIC Source File  |  2008-10-02  |  1KB  |  57 lines
  1. Attribute VB_Name = "Glob"
  2.  
  3. Global WepPage32(99) As Main
  4. Global WepPageNum As Integer
  5.  
  6. Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
  7. Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
  8. Public Const RAS95_MaxEntryName = 256
  9. Public Const RAS95_MaxDeviceType = 16
  10. Public Const RAS95_MaxDeviceName = 32
  11.  
  12. Public Type RASCONN95
  13.    dwSize As Long
  14.    hRasCon As Long
  15.    szEntryName(RAS95_MaxEntryName) As Byte
  16.    szDeviceType(RAS95_MaxDeviceType) As Byte
  17.    szDeviceName(RAS95_MaxDeviceName) As Byte
  18. End Type
  19.  
  20. Public Type RASCONNSTATUS95
  21.    dwSize As Long
  22.    RasConnState As Long
  23.    dwError As Long
  24.    szDeviceType(RAS95_MaxDeviceType) As Byte
  25.    szDeviceName(RAS95_MaxDeviceName) As Byte
  26. End Type
  27.  
  28.  
  29. Function IsConnected() As Boolean
  30.  
  31. Dim TRasCon(255) As RASCONN95
  32. Dim lg As Long
  33. Dim lpcon As Long
  34. Dim RetVal As Long
  35. Dim Tstatus As RASCONNSTATUS95
  36.  
  37. TRasCon(0).dwSize = 412
  38. lg = 256 * TRasCon(0).dwSize
  39.  
  40. RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
  41.  
  42. If RetVal <> 0 Then
  43.    MsgBox "ERROR"
  44.    Exit Function
  45. End If
  46.  
  47. Tstatus.dwSize = 160
  48. RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
  49.  
  50. If Tstatus.RasConnState = &H2000 Then
  51.    IsConnected = True
  52.    Else
  53.    IsConnected = False
  54. End If
  55.  
  56. End Function
  57.